Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr48/stsim2.zip/STOCK.PAS

Pascal/Delphi Source File | 1993-04-01 | 7KB | 353 lines

uses crt,menu,graph,sunit;
{ type
        date = record
                        month:byte;
                        day:byte;
                        year:word;
               end;

        dayptr = ^day;
        day = record
                price:real;
                thing:integer;
                        1 to 9999 is stock,
                        0 is player
                        -99 is stock market average.

                next:dayptr;
              end;

        stock = record
                        symbol : string[3];
                        shares : integer;
                end;

        company = record
                        name : string;
                        symbol : string[3];
                        cash : real;
                        stock_price : real;
                  end;
var
        universal_date:date;
        first_one,current:dayptr;

        co:array[1..20] of company;
        tmp_month:integer;
        num_co:integer;
        _flash:integer;
        _flash_str:string;
}

type
    rplayer = record
            stock:array[1..10] of stock;
            num_stock:integer;
            cash:real;
          end;
var
    num_rec:integer;
    cur_month:integer;
    player:rplayer;

procedure transact;forward;

procedure del_r(var d:dayptr);
var    x:dayptr;
begin
    x:=d;
    d:=d^.next;
    dispose(x);
end;
function stock_sum:real;forward;

function dow_jones:real;
var
    total:real; i:integer;
begin
    total:=0;
    for i:=1 to num_co do begin
        total:=total+co[i].stock_price;
    end;
    dow_jones:=total / num_co;
end;

procedure date_add;
var i:integer;
begin
        with universal_date do
        begin
                inc(day);
                if day>30 then begin
                        day:=1;
                        inc(month);
                end;

                if month>12 then begin
                        month:=1;
                        inc(year);
                end;
                gotoxy(70,3); write(month:2,'/',day:2,'/',year:4);
        end;

        for i:=1 to num_co do begin
                with current^ do begin
                        thing:=i;
                        price:=co[i].stock_price;
                end;
        new(current^.next);
        current:=current^.next;
        current^.next:=NIL;
        if num_rec>200 then begin
            del_r(first_one);
        end;
    end;
                with current^ do begin
            thing:=0;
            price:=stock_sum+player.cash;
                end;
        new(current^.next);
        current:=current^.next;
        current^.next:=NIL;
        if num_rec>200 then begin
            del_r(first_one);
        end;

                with current^ do begin
            thing:=-99;
            price:=dow_jones;
                end;
        new(current^.next);
        current:=current^.next;
        current^.next:=NIL;
        if num_rec>200 then begin
            del_r(first_one);
        end;
    inc(num_rec);
end;

procedure display;forward;
procedure _graph;
const
    left=50;
var
    grd,grm,c,i,divisor:integer;
    tmp:dayptr;
    s:string;

begin
    s:='';
    for c:=1 to num_co do with co[c] do begin
        s:=s+symbol+',';
    end;
    s:=s+'Player,Dow Average';

    s:=menu1(1,1,s);
    for c:=1 to num_co do
        if co[c].symbol=s then i:=c;
    if s='Player' then i:=0;
    if s='Dow Average' then i:=-99;
    textattr:=7;


    grd:=detect;
    initgraph(grd,grm,'');
    line(left,1,left,getmaxy);
    for c:=getmaxy downto 1 do
      if (c mod 20) = 0 then begin
        str(c,s);
        s:='$'+s;

        outtextxy(1,getmaxy-c,s);
      end;

    for c:=getmaxx downto 1 do
      if (c mod 50) = 0 then begin
        str(round(c/1.2),s);
        outtextxy(c,getmaxy-10,s);
      end;


    tmp:=first_one;

    c:=0;
    divisor:=1;
    if i=0 then divisor:=20;
        repeat
          if tmp^.thing=i then begin
           if c=0 then
        moveto(c+left,(getmaxy-round(tmp^.price/divisor))) else
        lineto(c+left,(getmaxy-round(tmp^.price/divisor)));
        inc(c);
          end;
          tmp:=tmp^.next;
    until tmp=NIL;
    repeat until keypressed;
    closegraph;
end;

procedure time_proc;
var
        x,y:integer;
begin
                        x:=wherex;y:=wherey;

            flash;
                        stock_window(3,4);
            transact;
            display;
            date_add;

            gotoxy(70,4);
            write(memavail);

            if universal_date.month<>cur_month then begin
                earn;
                cur_month:=universal_date.month;
            end;

                        gotoxy(x,y);
end;

procedure transact;
var i:integer;
begin
    for i:=1 to num_co do with co[i] do begin
        if random(2)=0 then
            stock_price:=stock_price+random(3) else
            stock_price:=stock_price-random(3);
    end;
end;

function priceof(s:string):real;
var i:integer;
begin
    for i:=1 to num_co do
        if co[i].symbol=s then priceof:=co[i].stock_price;
end;

function stock_sum:real;
var total:real;i:integer;
begin
    total:=0;
    with player do begin
        for i:=1 to num_stock do
            total:=total+(priceof(stock[i].symbol)*stock[i].shares)
    end;
    stock_sum:=total;
end;

procedure display;
begin
    box(60,10,79,15);
    gotoxy(61,11);
    write('Cash=>',player.cash:7:2);
    gotoxy(61,12);
    write('Stock=>',stock_sum:7:2);
    gotoxy(61,13);
    write('Dow=>',dow_jones:7:2);
end;

procedure pbuy;
var s:string;
    c,i:integer;
begin
    s:='';
    for c:=1 to num_co-1 do with co[c] do begin
        s:=s+symbol+',';
    end;
    s:=s+co[num_co].symbol;

    s:=menu1(1,1,s);
    for c:=1 to num_co do
        if co[c].symbol=s then begin
            writeln;writeln;
            writeln('How many shares?');
            readln(i);
            with player do
            if (i*co[c].stock_price)<cash then begin
                inc(num_stock);
                stock[num_stock].shares:=i;
                stock[num_stock].symbol:=s;
                cash:=cash-(i*co[c].stock_price);
            end;
        end;
end;

procedure psell;
var s:string;
    c,i:integer;
begin
    with player do begin
    s:='';
    for c:=1 to num_stock do with stock[c] do begin
        s:=s+symbol+',';
    end;

    s:=menu1(1,1,s);
    for c:=1 to num_stock do
        if stock[c].symbol=s then begin
            writeln;writeln;
            writeln('How many shares?');
            readln(i);
            if stock[c].shares<=i then begin
                stock[c].shares:=stock[c].shares-i;
                cash:=cash+(stock[c].shares*co[c].stock_price);
            end;
    end;
    end;
end;

procedure init_play;
begin
    player.cash:=5000;
    player.num_stock:=0;
end;

procedure init_commands;
begin
    box(1,17,30,25);
    window(2,18,29,24);
    gotoxy(1,1);
    textattr:=2;
    writeln('Commands:');
    textattr:=7;
    writeln('g-graph company,player,dow');
    writeln('b-buy stock of company');
    writeln('s-sell stock of company');
    writeln('q-quit simulation');
    window(1,1,80,25);
end;

label rep;
var
        timer:word;
    i:integer;
    ch:char;

begin
    textattr:=7;
    randomize;
    init;
        init_stocks;
    init_flash;
    init_play;
     rep:
        clrscr;
        gotoxy(50,20);
    write('Command=>');
    init_commands;
        repeat
                inc(timer);
        if timer>2000 then begin
                        time_proc;
            timer:=0;
        end;
    until keypressed;
    ch:=readkey;
    if ch='g' then _graph;
    if ch='b' then pbuy;
    if ch='s' then psell;
    if ch='q' then else goto rep;
end.